home *** CD-ROM | disk | FTP | other *** search
/ Libris Britannia 4 / science library(b).zip / science library(b) / HAMRADIO / RTTY12G.ZIP / RTTY.BAS < prev    next >
BASIC Source File  |  1986-06-02  |  43KB  |  731 lines
  1. 10 REM $LINESIZE:132
  2. 20 '***
  3. 30 '
  4. 40 ' RTTY PROGRAM FOR THE IBM PERSONAL COMPUTER
  5. 50 '
  6. 60 ' VERSION 1.2G
  7. 70 '
  8. 80 ' LAST CHANGED June 1, 1986
  9. 90 '
  10. 100 ' BY   GLENN E. WELMAN, KF4NB
  11. 110 '      3301 PASTERN CT.
  12. 120 '      LEXINGTON, KY 40513
  13. 130 '
  14. 140 '  (C) COPYRIGHT WELMAN SOFTWARE 1983, 1986
  15. 150 '***
  16. 160 '
  17. 170 '  FEEL FREE TO GIVE COPIES OF THIS PROGRAM TO YOUR FRIENDS.
  18. 180 '
  19. 190 '  PLEASE, DON'T SELL OR BARTER THE PROGRAM TO OTHERS.
  20. 200 '
  21. 210 '  IF YOU FIND BUGS IN THE PROGRAM, FEEL FREE TO
  22. 220 '  CORRESPOND DIRECTLY WITH ME. (SASE REQUESTED)
  23. 230 '
  24. 240 '  WHEN YOU PASS ALONG THE PROGRAM, INCLUDE ONLY THE
  25. 250 '  ORIGINAL UNMODIFIED VERSION.
  26. 260 '
  27. 270 '  DO NOT REMOVE THESE GUIDELINES FROM THE PROGRAM
  28. 280 '  OR DOCUMENT.
  29. 290 '
  30. 300 '  IF YOU FIND THE PROGRAM OF VALUE, A SMALL CONTRIBUTION
  31. 310 '  FOR MY EFFORT WILL BE APPRECIATED ($25 SUGGESTED).
  32. 320 '
  33. 330 '  73's
  34. 340 '  Glenn, KF4NB
  35. 350 '
  36. 360 '***
  37. 370 DEFINT A-Z
  38. 380 DIM BDLOW(31),BDUP(31),BDOUT(127),BUF(4000),BUFL(4000)
  39. 390 DIM MON(12),MO$(12),R$(5),FK$(20),FLNM$(10),MAXBAUD(1),BD.RTE(1,9),BD.RT$(1,9)
  40. 400 DIM SUBR%(3):'THIS CODE FOR COMPILED BASIC ONLY (5 LINES)
  41. 410 SUBR%(0)=&H5B59:SUBR%(1)=&H5153:SUBR%(2)=&HEB83:SUBR%(3)=&HCB10
  42. 420 DEF USR0 = VARPTR(SUBR%(0))
  43. 430 PL=0:P=USR0(PL):DEF SEG = P:P=PEEK(&H80):PS$=""
  44. 440 FOR PL=1 TO P:PS$=PS$+CHR$(PEEK(&H80+PL)):NEXT PL:DEF SEG
  45. 450 BSIZ=4000:'BUF(BSIZ) & BUFL(BSIZ)
  46. 460 'FIND SCREEN SIZE AND SET SCROLL PARMS
  47. 470 KEY OFF:COLOR 7,0:SCREEN 0,1:CLS
  48. 480 P=CSRLIN:PRINT STRING$(60," ");:IF P=CSRLIN THEN CMAX=80 ELSE CMAX=40
  49. 490 IF CMAX = 40 THEN LOCATE 10,15,0 ELSE LOCATE 10,35,0
  50. 500 PRINT"IBM PC RTTY":IF CMAX=40 THEN LOCATE 11,15,0 ELSE LOCATE 11,35,0
  51. 510 PRINT"Version 1.2G":IF CMAX=40 THEN LOCATE 13,13,0 ELSE LOCATE 13,33,0
  52. 520 PRINT"by Glenn Welman":IF CMAX=40 THEN LOCATE 15,18,0 ELSE LOCATE 15,38,0
  53. 530 PRINT"KF4NB":IF CMAX=40 THEN LOCATE 17,1,0 ELSE LOCATE 17,20,0
  54. 540 PRINT"(C) Copyright Welman Software 1983,1984":LOCATE 24,1,0:PRINT"Press any key to start";
  55. 550 P=VAL(RIGHT$(TIME$,2)):P=P+10:IF P>59 THEN P=P-60
  56. 560 IF INKEY$<>"" THEN 580
  57. 570 IF P<>VAL(RIGHT$(TIME$,2)) THEN 560
  58. 580 REM $PAGE
  59. 590 'BAUDOT RX CONVERSION TABLE
  60. 600 CLS
  61. 610 BDLOW(0)=&H0:BDUP(0)=&H0:BDLOW(1)=&H45:BDUP(1)=&H33:BDLOW(2)=&HA:BDUP(2)=&HA:BDLOW(3)=&H41:BDUP(3)=&H2D
  62. 620 BDLOW(4)=&H20:BDUP(4)=&H20:BDLOW(5)=&H53:BDUP(5)=&H7:BDLOW(6)=&H49:BDUP(6)=&H38:BDLOW(7)=&H55:BDUP(7)=&H37
  63. 630 BDLOW(8)=&HD:BDUP(8)=&HD:BDLOW(9)=&H44:BDUP(9)=&H24:BDLOW(10)=&H52:BDUP(10)=&H34:BDLOW(11)=&H4A:BDUP(11)=&H27
  64. 640 BDLOW(12)=&H4E:BDUP(12)=&H2C:BDLOW(13)=&H46:BDUP(13)=&H21:BDLOW(14)=&H43:BDUP(14)=&H3A:BDLOW(15)=&H4B:BDUP(15)=&H28
  65. 650 BDLOW(16)=&H54:BDUP(16)=&H35:BDLOW(17)=&H5A:BDUP(17)=&H22:BDLOW(18)=&H4C:BDUP(18)=&H29:BDLOW(19)=&H57:BDUP(19)=&H32
  66. 660 BDLOW(20)=&H48:BDUP(20)=&H23:BDLOW(21)=&H59:BDUP(21)=&H36:BDLOW(22)=&H50:BDUP(22)=&H30:BDLOW(23)=&H51:BDUP(23)=&H31
  67. 670 BDLOW(24)=&H4F:BDUP(24)=&H39:BDLOW(25)=&H42:BDUP(25)=&H3F:BDLOW(26)=&H47:BDUP(26)=&H26:BDLOW(27)=&H18:BDUP(27)=&H18
  68. 680 BDLOW(28)=&H4D:BDUP(28)=&H2E:BDLOW(29)=&H58:BDUP(29)=&H2F:BDLOW(30)=&H56:BDUP(30)=&H3B:BDLOW(31)=&H19:BDUP(31)=&H19
  69. 690 'BAUDOT TX CONVERSION TABLE
  70. 700 BDOUT(0)=&HC0:BDOUT(1)=&HC0:BDOUT(2)=&HC0:BDOUT(3)=&HC0:BDOUT(4)=&HC0:BDOUT(5)=&HC0:BDOUT(6)=&HC0:BDOUT(7)=&H85
  71. 710 BDOUT(8)=&HC0:BDOUT(9)=&HC0:BDOUT(10)=&HC2:BDOUT(11)=&HC0:BDOUT(12)=&HC0:BDOUT(13)=&HC8:BDOUT(14)=&HC0:BDOUT(15)=&HC0
  72. 720 BDOUT(16)=&HC0:BDOUT(17)=&HC0:BDOUT(18)=&HC0:BDOUT(19)=&HC0:BDOUT(20)=&HC0:BDOUT(21)=&HC0:BDOUT(22)=&HC0:BDOUT(23)=&HC0
  73. 730 BDOUT(24)=&H9B:BDOUT(25)=&H5F:BDOUT(26)=&HC0:BDOUT(27)=&HC0:BDOUT(28)=&HC0:BDOUT(29)=&HC0:BDOUT(30)=&HC0:BDOUT(31)=&HC0
  74. 740 BDOUT(32)=&H44:BDOUT(33)=&H8D:BDOUT(34)=&H91:BDOUT(35)=&H94:BDOUT(36)=&H89:BDOUT(37)=&HC0:BDOUT(38)=&H9A:BDOUT(39)=&H8B
  75. 750 BDOUT(40)=&H8F:BDOUT(41)=&H92:BDOUT(42)=&HC8:BDOUT(43)=&H5F:BDOUT(44)=&H8C:BDOUT(45)=&H83:BDOUT(46)=&H9C:BDOUT(47)=&H9D
  76. 760 BDOUT(48)=&H96:BDOUT(49)=&H97:BDOUT(50)=&H93:BDOUT(51)=&H81:BDOUT(52)=&H8A:BDOUT(53)=&H90:BDOUT(54)=&H95:BDOUT(55)=&H87
  77. 770 BDOUT(56)=&H86:BDOUT(57)=&H98:BDOUT(58)=&H8E:BDOUT(59)=&H9E:BDOUT(60)=&H5F:BDOUT(61)=&HC2:BDOUT(62)=&H9B:BDOUT(63)=&H99
  78. 780 BDOUT(64)=&H85:BDOUT(65)=&H43:BDOUT(66)=&H59:BDOUT(67)=&H4E:BDOUT(68)=&H49:BDOUT(69)=&H41:BDOUT(70)=&H4D:BDOUT(71)=&H5A
  79. 790 BDOUT(72)=&H54:BDOUT(73)=&H46:BDOUT(74)=&H4B:BDOUT(75)=&H4F:BDOUT(76)=&H52:BDOUT(77)=&H5C:BDOUT(78)=&H4C:BDOUT(79)=&H58
  80. 800 BDOUT(80)=&H56:BDOUT(81)=&H57:BDOUT(82)=&H4A:BDOUT(83)=&H45:BDOUT(84)=&H50:BDOUT(85)=&H47:BDOUT(86)=&H5E:BDOUT(87)=&H53
  81. 810 BDOUT(88)=&H5D:BDOUT(89)=&H55:BDOUT(90)=&H51:BDOUT(91)=&H9B:BDOUT(92)=&HC0:BDOUT(93)=&H5F:BDOUT(94)=&HC0:BDOUT(95)=&HC0
  82. 820 BDOUT(96)=&HC0:BDOUT(97)=&H43:BDOUT(98)=&H59:BDOUT(99)=&H4E:BDOUT(100)=&H49:BDOUT(101)=&H41:BDOUT(102)=&H4D:BDOUT(103)=&H5A
  83. 830 BDOUT(104)=&H54:BDOUT(105)=&H46:BDOUT(106)=&H4B:BDOUT(107)=&H4F:BDOUT(108)=&H52:BDOUT(109)=&H5C:BDOUT(110)=&H4C:BDOUT(111)=&H58
  84. 840 BDOUT(112)=&H56:BDOUT(113)=&H57:BDOUT(114)=&H4A:BDOUT(115)=&H45:BDOUT(116)=&H50:BDOUT(117)=&H47:BDOUT(118)=&H5E:BDOUT(119)=&H53
  85. 850 BDOUT(120)=&H5D:BDOUT(121)=&H55:BDOUT(122)=&H51:BDOUT(123)=&HC0:BDOUT(124)=&HC0:BDOUT(125)=&HC0:BDOUT(126)=&HC0:BDOUT(127)=&HC0
  86. 860 REM $PAGE
  87. 870 'READ THE INIT PARMS
  88. 880 DEF SEG=&H40:DIV.LSB1=PEEK(0)+(256*PEEK(1)):DIV.LSB2=PEEK(2)+(256*PEEK(3)):DEF SEG=&HFFFF:MACH.TYPE=PEEK(&HE):DEF SEG
  89. 890 IF MACH.TYPE=&HFD THEN XTAL!=1789770!/16 ELSE XTAL!=1843200!/16
  90. 900 COMM=1:DIV.LSB=DIV.LSB1:LPTR$="LPT1:":QSO$="":TYPE=1
  91. 910 CWARN=57:CEND=65:NCHR=60:QTIME=-1:RTS=1:DTR=1:ALCR=&H3E:NCHK$=""
  92. 920 GBSEL$=CHR$(25)+"N"+CHR$(25)+"N"+CHR$(25)+"N":GASEL$="QST":ESEL$="NNNN":GESEL$="NNNN":BSELCAL$="??????????":ASELCAL$="??????????"
  93. 930 PDAT$="DAY YYMODDHHMMSS":RXLINES=11:DTM$="HH:MM:SS TMT    MONTH DD, YYYY"
  94. 940 MAXBAUD(0)=6:MAXBAUD(1)=4:NOTKEYS$="* CONNECTE"
  95. 950 BD.RTE(0,0)=110!:BD.RTE(0,1)=100!:BD.RTE(0,2)=200!:BD.RTE(0,3)=300!:BD.RTE(0,4)=400!:BD.RTE(0,5)=1200!
  96. 960 BD.RT$(0,0)="110   ":BD.RT$(0,1)="100   ":BD.RT$(0,2)="200   ":BD.RT$(0,3)="300   ":BD.RT$(0,4)="400   ":BD.RT$(0,5)="1200  "
  97. 970 BD.RT$(0,6)="      ":BD.RT$(0,7)="      ":BD.RT$(0,8)="      ":BD.RT$(0,9)="      "
  98. 980 BD.RTE(1,0)=45.5:BD.RTE(1,1)=50!:BD.RTE(1,2)=56.9:BD.RTE(1,3)=74.2
  99. 990 BD.RT$(1,0)="45.5  ":BD.RT$(1,1)="50.0  ":BD.RT$(1,2)="56.9  ":BD.RT$(1,3)="74.2  ":BD.RT$(1,4)="      "
  100. 1000 BD.RT$(1,5)="      ":BD.RT$(1,6)="      ":BD.RT$(1,7)="      ":BD.RT$(1,8)="      ":BD.RT$(1,9)="      "
  101. 1010 'SET DEFAULT COLOR PARMS
  102. 1020 TXF=7:RXF=7:STSB=7:KEYB=7:ERRB=7
  103. 1030 REM $PAGE
  104. 1040 IF RST THEN INPUT "ENTER THE NAME OF THE FILE CONTAINING RUNTIME PARAMETERS";PS$
  105. 1050 IF LEFT$(PS$,1)=" " THEN PS$=RIGHT$(PS$,LEN(PS$)-1):GOTO 1050
  106. 1060 IF PS$="" THEN PARMS$="PARMS.RTY" ELSE PARMS$=PS$
  107. 1070 ON ERROR GOTO 3980
  108. 1080 FERR=0:OPEN PARMS$ FOR INPUT AS #1
  109. 1090 IF FERR THEN IF INSTR(PARMS$,".")=0 THEN PARMS$=PARMS$+".RTY":GOTO 1080 ELSE PRINT "ERROR ACCESSING FILE - ";PARMS$:PRINT "ERROR NUMBER";ERR:GOTO 1800
  110. 1100 WHILE NOT EOF(1)
  111. 1110 INPUT#1,P$:IF P$="" THEN GOTO 1790
  112. 1120 FOR PL=1 TO LEN(P$)
  113. 1130 P=ASC(MID$(P$,PL,1)):IF (P>&H60) AND (P<&H7B) THEN MID$(P$,PL,1)=CHR$(P-&H20)
  114. 1140 NEXT PL:PL$=LEFT$(P$,4):PRINT P$
  115. 1150 IF PL$="XTAL" THEN PL=INSTR(P$,"="):IF PL=0 OR PL=LEN(P$) THEN 1780 ELSE XTAL!=VAL(RIGHT$(P$,LEN(P$)-PL))*1000000!/16:GOTO 1790
  116. 1160 IF PL$="COMM" THEN PL=INSTR(P$,"="):IF PL=0 OR PL=LEN(P$) THEN 1780 ELSE DIV.LSB=VAL(RIGHT$(P$,LEN(P$)-PL)):GOTO 1790
  117. 1170 IF PL$="COM2" THEN COMM=2:DIV.LSB=DIV.LSB2:GOTO 1790
  118. 1180 IF PL$="TIME" THEN PL=INSTR(P$,"="):IF PL=0 OR PL=LEN(P$) THEN 1780 ELSE TMTYP$=RIGHT$(P$,LEN(P$)-PL):IF LEFT$(TMTYP$,1)="?" THEN GOTO 1790 ELSE QTIME=0:TMTYP$=LEFT$(TMTYP$,3):GOTO 1790
  119. 1190 IF LEFT$(PL$,3)="RTS" THEN PL=INSTR(P$,"="):IF PL=0 OR PL=LEN(P$) THEN 1780 ELSE RTS=VAL(RIGHT$(P$,LEN(P$)-PL)):IF (RTS>1 AND RTS<10) OR (RTS>11) THEN 1780 ELSE 1790
  120. 1200 IF LEFT$(PL$,3)="DTR" THEN PL=INSTR(P$,"="):IF PL=0 OR PL=LEN(P$) THEN 1780 ELSE DTR=VAL(RIGHT$(P$,LEN(P$)-PL)):IF (DTR>1 AND DTR<10) OR (DTR>11) THEN 1780 ELSE 1790
  121. 1210 IF PL$<>"BAUD" THEN 1240 ELSE PL=INSTR(P$,"="):IF PL=0 OR PL=LEN(P$) THEN 1780
  122. 1220 IF PL=5 THEN IF MAXBAUD(1)=10 THEN 1780 ELSE P=MAXBAUD(1):MAXBAUD(1)=P+1:GOTO 1230 ELSE P=VAL(MID$(P$,5,PL-5)):IF P>10 OR P>MAXBAUD(1)+1 THEN 1780 ELSE IF P>MAXBAUD(1) THEN MAXBAUD(1)=P:P=P-1 ELSE P=P-1
  123. 1230 BD.RTE(1,P)=VAL(RIGHT$(P$,LEN(P$)-PL)):MID$(BD.RT$(1,P),1)=RIGHT$(P$,LEN(P$)-PL)+"      ":GOTO 1790
  124. 1240 IF PL$<>"ASCI" THEN 1270 ELSE PL=INSTR(P$,"="):IF PL=0 OR PL=LEN(P$) THEN 1780
  125. 1250 IF PL=5 THEN IF MAXBAUD(0)=10 THEN 1780 ELSE P=MAXBAUD(0):MAXBAUD(0)=P+1:GOTO 1260 ELSE P=VAL(MID$(P$,5,PL-5)):IF P>10 OR P>MAXBAUD(0)+1 THEN 1780 ELSE IF P>MAXBAUD(0) THEN MAXBAUD(0)=P:P=P-1 ELSE P=P-1
  126. 1260 BD.RTE(0,P)=VAL(RIGHT$(P$,LEN(P$)-PL)):MID$(BD.RT$(0,P),1)=RIGHT$(P$,LEN(P$)-PL)+"      ":GOTO 1790
  127. 1270 IF PL$="BSEL" THEN PL=INSTR(P$,"="):IF PL=0 OR PL=LEN(P$) THEN 1780 ELSE BSELCAL$=MID$(P$,PL+1,10):GOTO 1790
  128. 1280 IF PL$="ASEL" THEN PL=INSTR(P$,"="):IF PL=0 OR PL=LEN(P$) THEN 1780 ELSE ASELCAL$=MID$(P$,PL+1,10):GOTO 1790
  129. 1290 IF PL$="BGSL" THEN PL=INSTR(P$,"="):IF PL=0 OR PL=LEN(P$) THEN 1780 ELSE GBSEL$=MID$(P$,PL+1,10):GOTO 1790
  130. 1300 IF PL$="AGSL" THEN PL=INSTR(P$,"="):IF PL=0 OR PL=LEN(P$) THEN 1780 ELSE GASEL$=MID$(P$,PL+1,10):GOTO 1790
  131. 1310 IF PL$="ESEL" THEN PL=INSTR(P$,"="):IF PL=0 OR PL=LEN(P$) THEN 1780 ELSE ESEL$=MID$(P$,PL+1,10):GOTO 1790
  132. 1320 IF PL$="GESL" THEN PL=INSTR(P$,"="):IF PL=0 OR PL=LEN(P$) THEN 1780 ELSE GESEL$=MID$(P$,PL+1,10):GOTO 1790
  133. 1330 IF PL$="NKEY" THEN PL=INSTR(P$,"="):IF PL=0 OR PL=LEN(P$) THEN 1780 ELSE NOTKEYS$=MID$(P$,PL+1,10):GOTO 1790
  134. 1340 IF PL$="COLO" THEN TXF=11:TXB=1:RXF=14:RXB=2:STSF=0:STSB=6:KEYF=0:KEYB=3:ERRF=12:ERRB=0:GOTO 1790
  135. 1350 IF LEFT$(PL$,3)="TXF" THEN PL=INSTR(P$,"="):IF PL=0 OR PL=LEN(P$) THEN 1780 ELSE TXF=VAL(RIGHT$(P$,LEN(P$)-PL)):GOTO 1790
  136. 1360 IF LEFT$(PL$,3)="TXB" THEN PL=INSTR(P$,"="):IF PL=0 OR PL=LEN(P$) THEN 1780 ELSE TXB=VAL(RIGHT$(P$,LEN(P$)-PL)):GOTO 1790
  137. 1370 IF LEFT$(PL$,3)="RXF" THEN PL=INSTR(P$,"="):IF PL=0 OR PL=LEN(P$) THEN 1780 ELSE RXF=VAL(RIGHT$(P$,LEN(P$)-PL)):GOTO 1790
  138. 1380 IF LEFT$(PL$,3)="RXB" THEN PL=INSTR(P$,"="):IF PL=0 OR PL=LEN(P$) THEN 1780 ELSE RXB=VAL(RIGHT$(P$,LEN(P$)-PL)):GOTO 1790
  139. 1390 IF PL$="STSF" THEN PL=INSTR(P$,"="):IF PL=0 OR PL=LEN(P$) THEN 1780 ELSE STSF=VAL(RIGHT$(P$,LEN(P$)-PL)):GOTO 1790
  140. 1400 IF PL$="STSB" THEN PL=INSTR(P$,"="):IF PL=0 OR PL=LEN(P$) THEN 1780 ELSE STSB=VAL(RIGHT$(P$,LEN(P$)-PL)):GOTO 1790
  141. 1410 IF PL$="KEYF" THEN PL=INSTR(P$,"="):IF PL=0 OR PL=LEN(P$) THEN 1780 ELSE KEYF=VAL(RIGHT$(P$,LEN(P$)-PL)):GOTO 1790
  142. 1420 IF PL$="KEYB" THEN PL=INSTR(P$,"="):IF PL=0 OR PL=LEN(P$) THEN 1780 ELSE KEYB=VAL(RIGHT$(P$,LEN(P$)-PL)):GOTO 1790
  143. 1430 IF PL$="ERRF" THEN PL=INSTR(P$,"="):IF PL=0 OR PL=LEN(P$) THEN 1780 ELSE ERRF=VAL(RIGHT$(P$,LEN(P$)-PL)):GOTO 1790
  144. 1440 IF PL$="ERRB" THEN PL=INSTR(P$,"="):IF PL=0 OR PL=LEN(P$) THEN 1780 ELSE ERRB=VAL(RIGHT$(P$,LEN(P$)-PL)):GOTO 1790
  145. 1450 IF PL$="ALCR" THEN PL=INSTR(P$,"="):IF PL=0 OR PL=LEN(P$) THEN 1780 ELSE ALCR=VAL(RIGHT$(P$,LEN(P$)-PL)):GOTO 1790
  146. 1460 IF PL$="BDUP" THEN PL=INSTR(P$,"="):IF PL=0 OR PL=LEN(P$) THEN 1780 ELSE BDUP(VAL(MID$(P$,5,PL-5)))=VAL(RIGHT$(P$,LEN(P$)-PL)):GOTO 1790
  147. 1470 IF PL$="BDLW" THEN PL=INSTR(P$,"="):IF PL=0 OR PL=LEN(P$) THEN 1780 ELSE BDLOW(VAL(MID$(P$,5,PL-5)))=VAL(RIGHT$(P$,LEN(P$)-PL)):GOTO 1790
  148. 1480 IF PL$="BDOT" THEN PL=INSTR(P$,"="):IF PL=0 OR PL=LEN(P$) THEN 1780 ELSE BDOUT(VAL(MID$(P$,5,PL-5)))=VAL(RIGHT$(P$,LEN(P$)-PL)):GOTO 1790
  149. 1490 IF PL$="RXLN" THEN PL=INSTR(P$,"="):IF PL=0 OR PL=LEN(P$) THEN 1780 ELSE RXL=VAL(RIGHT$(P$,LEN(P$)-PL)):IF RXL<2 OR RXL>(19+INT(CMAX/60)) THEN 1780 ELSE RXLINES=RXL:GOTO 1790
  150. 1500 IF PL$="DIDL" THEN DIDL=-1:GOTO 1790
  151. 1510 IF PL$="ECHO" THEN ECHO=-1:GOTO 1790
  152. 1520 IF PL$="LPT2" THEN LPTR$="LPT2:":GOTO 1790
  153. 1530 IF PL$="LPT3" THEN LPTR$="LPT3:":GOTO 1790
  154. 1540 IF PL$="QB" THEN QBEL=-1:GOTO 1790
  155. 1550 IF PL$="ART" THEN ART=-1:GOTO 1790
  156. 1560 IF PL$="UOS" THEN UNSHIFT=-1:GOTO 1790
  157. 1570 IF PL$="HAND" THEN HAND=-1:GOTO 1790
  158. 1580 IF PL$="XMIT" THEN XMIT=-1:GOTO 1790
  159. 1590 IF PL$="ZULU" THEN ZTM=-1:DTM$="DDHHMMZ MON YY":PL=INSTR(P$,"="):IF PL=0 OR PL=LEN(P$) THEN 1790 ELSE ZTM=-2:UTM=VAL(RIGHT$(P$,LEN(P$)-PL)):GOTO 1790
  160. 1600 IF PL$="PKDT" THEN PDATOK=-1:GOTO 1790
  161. 1610 IF PL$="PDAT" THEN PL=INSTR(P$,"="):IF PL=0 OR PL=LEN(P$) THEN 1780 ELSE PDAT$=RIGHT$(P$,LEN(P$)-PL):GOTO 1790
  162. 1620 IF PL$="PACK" THEN PACKET=-1:HAND=-1:XMIT=-1:RTS=11:DTR=11:TYPE=0:ALCR=&H3:GOTO 1790
  163. 1630 IF PL$="SPLF" THEN SPLF=-1:GOTO 1790
  164. 1640 IF PL$="MODE" THEN PL=INSTR(P$,"="):IF PL=0 OR PL=LEN(P$) THEN 1780 ELSE IF MID$(P$,PL+1)="A" THEN TYPE=0:GOTO 1790 ELSE 1780
  165. 1650 IF PL$="BLLF" THEN BLLF=-1:GOTO 1790
  166. 1660 IF PL$="NOBP" THEN NOBP=-1:GOTO 1790
  167. 1670 IF PL$="ATCR" THEN ATCR=-1:GOTO 1790
  168. 1680 IF PL$="WARN" THEN PL=INSTR(P$,"="):IF PL=0 OR PL=LEN(P$) THEN 1780 ELSE CWARN=VAL(RIGHT$(P$,LEN(P$)-PL))+1:GOTO 1790
  169. 1690 IF PL$="LLEN" THEN PL=INSTR(P$,"="):IF PL=0 OR PL=LEN(P$) THEN 1780 ELSE CEND=VAL(RIGHT$(P$,LEN(P$)-PL))+1:GOTO 1790
  170. 1700 IF PL$="MARS" THEN MARS=-1:BDOUT(32)=&HC4:GOTO 1790
  171. 1710 IF PL$="NCHR" THEN PL=INSTR(P$,"="):IF PL=0 OR PL=LEN(P$) THEN 1780 ELSE NCHR=VAL(RIGHT$(P$,LEN(P$)-PL)):GOTO 1790
  172. 1720 IF PL$="DTTM" THEN PL=INSTR(P$,"="):IF PL=0 OR PL=LEN(P$) THEN 1780 ELSE DTM$=RIGHT$(P$,LEN(P$)-PL):GOTO 1790
  173. 1730 IF PL$="EURO" THEN EURO=-1:DTM$="HH:MM:SS TMT    DD.MON.YYYY" ELSE GOTO 1770
  174. 1740 ATCR=-1:BDUP(5)=&H27:BDUP(9)=&H23:BDUP(11)=&H7:BDUP(13)=&H5B:BDUP(17)=&H2B:BDUP(20)=&H21:BDUP(26)=&H5D:BDUP(30)=&H3D
  175. 1750 BDOUT(34)=&HC0:BDOUT(36)=&HC0:BDOUT(38)=&HC0:BDOUT(59)=&HC0:
  176. 1760 BDOUT(7)=&H8B:BDOUT(33)=&H94:BDOUT(35)=&H89:BDOUT(39)=&H85:BDOUT(43)=&H91:BDOUT(61)=&H9E:BDOUT(91)=&H8D:BDOUT(93)=&H9A:GOTO 1790
  177. 1770 IF PL$="FILE" THEN PL=INSTR(P$,"="):IF PL=0 OR PL=LEN(P$) THEN 1780 ELSE P=VAL(MID$(P$,5,PL-5)):IF P<1 OR P>10 THEN 1780 ELSE FLNM$(P)=RIGHT$(P$,LEN(P$)-PL):GOTO 1790
  178. 1780 PRINT "INVALID PARMS.RTY ENTRY":PRINT "    ";P$;"    ":INPUT "PRESS ENTER TO CONTINUE";P$
  179. 1790 WEND
  180. 1800 CLOSE #1
  181. 1810 P=VAL(RIGHT$(TIME$,2)):P=P+3:IF P>59 THEN P=P-60
  182. 1820 IF INKEY$<>"" THEN 1840
  183. 1830 IF P<>VAL(RIGHT$(TIME$,2)) THEN 1820
  184. 1840 MOD.CTL=DIV.LSB+4:LINE.CTL=DIV.LSB+3:DIV.MSB=DIV.LSB+1:LINE.STS=DIV.LSB+5
  185. 1850 IF COMM=1 THEN COMM$="COM1" ELSE COMM$="COM2"
  186. 1860 IER=DIV.MSB
  187. 1870 RMSK=0:TMSK=0
  188. 1880 IF RTS>1 THEN RMSK=2
  189. 1890 IF RTS=1 OR RTS=11 THEN TMSK=2
  190. 1900 IF DTR>1 THEN RMSK=RMSK+1
  191. 1910 IF DTR=1 OR DTR=11 THEN TMSK=TMSK+1
  192. 1920 TXBR=TXB:TXFR=TXF MOD 8:TXB=TXB MOD 8:TXF=TXF MOD 32:SCTX=(TXB*16)+(TXF MOD 16)
  193. 1930 RXB=RXB MOD 8:RXF=RXF MOD 32:SCRX=(RXB*16)+(RXF MOD 16)
  194. 1940 STSBR=STSB:STSFR=STSF MOD 8:STSB=STSB MOD 8:STSF=STSF MOD 32
  195. 1950 KEYBR=KEYB:KEYFR=KEYF MOD 8:KEYB=KEYB MOD 8:KEYF=KEYF MOD 32
  196. 1960 ERRBR=ERRB:ERRFR=ERRF MOD 8:ERRB=ERRB MOD 8:ERRF=ERRF MOD 32
  197. 1970 'READ THE TTY ID
  198. 1980 FERR=0:OPEN "TTYID.RTY" FOR INPUT AS #1
  199. 1990 IF FERR THEN TTYID$="":GOTO 2010
  200. 2000 LINE INPUT#1,TTYID$:TTYID$=" "+TTYID$+CHR$(254)
  201. 2010 CLOSE #1
  202. 2020 RRB=1:RRE=RXLINES:TMLN1=RRE+1:TMLN2=RRE+2
  203. 2030 RWE=23:IF CMAX=40 THEN RWB=RRE+3:SL=24 ELSE RWB=RRE+2:SL=25
  204. 2040 FOR PL=0 TO BSIZ:BUFL(PL)=-1:NEXT PL
  205. 2050 MO$(1)="January":MO$(2)="February":MO$(3)="March":MO$(4)="April"
  206. 2060 MO$(5)="May":MO$(6)="June":MO$(7)="July":MO$(8)="August"
  207. 2070 MO$(9)="September":MO$(10)="October":MO$(11)="November":MO$(12)="December"
  208. 2080 MON(1)=31:MON(2)=28:MON(3)=31:MON(4)=30:MON(5)=31:MON(6)=30
  209. 2090 MON(7)=31:MON(8)=31:MON(9)=30:MON(10)=31:MON(11)=30:MON(12)=31
  210. 2100 REM $PAGE
  211. 2110 'INITIALIZE VARIABLES
  212. 2120 COLOR 7,0:CLS:MODE=0:BAUD=0:PRNTR=0:KEYS=-1
  213. 2130 BUFS=0:BUFE=0:BUFFULL=0:RFCNT=0:RCNT=1:TXBUF=0
  214. 2140 RST=0:BFILE=0:RFILE=0:DFILE=0:TPAUSE=0:CLOSE
  215. 2150 WIDTH LPTR$,255
  216. 2160 OPEN LPTR$ AS #4
  217. 2170 RR=RRB:CR=1
  218. 2180 RW=RWB:CW=1
  219. 2190 'SET GLOBAL KEYS
  220. 2200 FK$(1)="KEYS  ":FK$(3)="RX FLE":FK$(5)="END   ":FK$(6)="PRT OF":FK$(7)="45.5  ":FK$(9)="NEW LN":FK$(10)="LTRS  ":IF TYPE=0 THEN FK$(8)="ASCII " ELSE FK$(8)="BAUDOT"
  221. 2210 FK$(11)="KEYS  ":FK$(13)="TX FLE":FK$(14)="TX CQ ":FK$(15)="RESET ":FK$(16)="TX RYS":FK$(17)="PSE OF":FK$(18)="TTY ID":FK$(19)="QSO ID":FK$(20)="DT&TM "
  222. 2220 GOSUB 4750
  223. 2230 IF UNSHIFT THEN FK$(4)="UOS ON" ELSE FK$(4)="UOS OF"
  224. 2240 ON ERROR GOTO 3910
  225. 2250 'START COMM FILE
  226. 2260 PL=INP(LINE.STS)
  227. 2270 IF HAND THEN OPEN COMM$+":110,N,7,2" AS #1 ELSE OPEN COMM$+":110,N,7,2,RS,CS0,DS0" AS #1
  228. 2280 IF XMIT THEN GOSUB 4620:'SET TO XMIT MODE
  229. 2290 GOSUB 4250
  230. 2300 OUT MOD.CTL,(INP(MOD.CTL) AND &HFC) OR RMSK:'SET DTR AND RTS
  231. 2310 ON KEY(1) GOSUB 4010:KEY(1) ON:ON KEY(2) GOSUB 4620:KEY(2) ON
  232. 2320 GOSUB 4010
  233. 2330 IF NOT QTIME THEN 2420
  234. 2340 CLS:PRINT "THE DEFAULT TIME TYPE IS 'UTC'":INPUT "ENTER THE TIME TYPE ";TMTYP$:IF TMTYP$="" THEN TMTYP$="UTC" ELSE FOR PL=1 TO LEN(TMTYP$):P=ASC(MID$(TMTYP$,PL,1)):IF (P>&H60) AND (P<&H7B) THEN MID$(TMTYP$,PL,1)=CHR$(P-&H20):NEXT PL
  235. 2350 TMTYP$=LEFT$(TMTYP$,3)
  236. 2360 PRINT "THE TIME IS SET TO "+TIME$+" "+TMTYP$
  237. 2370 INPUT "ENTER THE TIME ";TCH$
  238. 2380 IF TCH$<>"" THEN TIME$ = TCH$
  239. 2390 PRINT "THE DATE IS SET TO "+DATE$
  240. 2400 INPUT "ENTER THE DATE ";TCH$
  241. 2410 IF TCH$<>"" THEN DATE$=TCH$
  242. 2420 TCH = VAL(RIGHT$(DATE$,4)):MON(2)=28:IF (TCH MOD 4) = 0 AND (TCH MOD 100) <>0 THEN MON(2)=29
  243. 2430 IF TMTYP$="UTC" THEN UTM=0 ELSE IF ZTM=-1 THEN INPUT "ENTER THE TIME DIFFERENCE FOR ZULU TIME";UTM
  244. 2440 IF ZTM=-2 THEN ZTM=-1
  245. 2450 CLS:GOSUB 4630:GOSUB 4110
  246. 2460 IF PACKET AND PDATOK THEN GOSUB 6650
  247. 2470 FOR PL = 1 TO 25
  248. 2480 CALL SCROLL (RRB,RRE,CMAX,SCRX)
  249. 2490 CALL SCROLL (RWB,RWE,CMAX,SCTX)
  250. 2500 NEXT PL
  251. 2510 LOCATE RW,CW,0:COLOR TXBR,TXFR:PRINT " ";
  252. 2520 GOSUB 6280:TSS!=TCS!
  253. 2530 IF INKEY$<>"" THEN 2530
  254. 2540 GOSUB 6300
  255. 2550 REM $PAGE
  256. 2560 'MAIN PROGRAM LOOP
  257. 2570 COLOR STSF,STSB:LOCATE TMLN1,1,0:PRINT TIME$+" "+TMTYP$;:IF DATE$ <> ZDT$ THEN GOSUB 6300
  258. 2580 GOSUB 6280:IF TCS!<TSS! THEN TCS!=TCS!+86400!
  259. 2590 TS!=TCS!-TSS!:TH=INT(TS!/3600):TM=INT(TS!/60)-TH*60:TS=TS!-CSNG(TH)*3600-CSNG(TM)*60:LOCATE TMLN1,30,0:PRINT USING "##_:##_:##";TH,TM,TS;
  260. 2600 IF BFILE THEN IF CMAX=40 THEN LOCATE TMLN2,1,0 ELSE LOCATE TMLN1,41,0
  261. 2610 IF BFILE THEN PRINT LEFT$("RX-"+BF$,19);
  262. 2620 IF RFILE THEN IF CMAX=40 THEN LOCATE TMLN2,21,0 ELSE LOCATE TMLN1,61,0
  263. 2630 IF RFILE THEN PRINT LEFT$("TX-"+RF$,19);
  264. 2640 COLOR TXF,TXB
  265. 2650 TCS!=FRE("")
  266. 2660 IF MSG THEN IF PMSG=VAL(RIGHT$(TIME$,2)) THEN GOSUB 6370
  267. 2670 FOR ML = 1 TO 10
  268. 2680 IF RST THEN IF PS$="" THEN 2120 ELSE CLOSE:CLEAR:RST=-1:GOTO 450
  269. 2690 IF NEWLINE THEN NEWLINE=0:B$=CHR$(13):GOSUB 4520:B$=CHR$(10):GOSUB 4520
  270. 2700 FOR MLL = 1 TO 2:IF NOT EOF(1) THEN GOSUB 3200:NEXT MLL
  271. 2710 IF TXEND THEN GOSUB 4660:GOTO 2740
  272. 2720 IF MODE=1 AND BUFS<>BUFE THEN GOSUB 4790 ELSE IF DIDL AND (MODE=1) AND NOT TPAUSE THEN GOSUB 6280:IF LDS<>SS THEN LDS=SS:COA=0:GOSUB 4870
  273. 2730 IF COA = 5 THEN GOSUB 4620:COA=0
  274. 2740 IF BUFFULL THEN 2780
  275. 2750 IF UNCOMP THEN GOSUB 5060:GOTO 2780
  276. 2760 IF RFILE THEN IF NOT EOF(2) THEN TCH$=INPUT$(1,#2):GOSUB 5060:GOTO 2780 ELSE GOSUB 5790:GOTO 2780
  277. 2770 IF DFILE THEN IF LEN(DTTM$)=0 THEN DFILE=0 ELSE TCH$=LEFT$(DTTM$,1):DTTM$=RIGHT$(DTTM$,LEN(DTTM$)-1):GOSUB 5060
  278. 2780 KCH$=INKEY$:IF KCH$="" THEN GOTO 3130
  279. 2790 IF LEN(KCH$)=1 THEN GOTO 3130 ELSE KCH2=ASC(RIGHT$(KCH$,1))
  280. 2800 IF KCH2=50 THEN DTTM$=DTTM$+CHR$(3)+"X":DFILE=-1:GOTO 3160:'a-M
  281. 2810 IF KCH2=23 THEN DTTM$=DTTM$+CHR$(3)+"R":DFILE=-1:GOTO 3160:'a-I
  282. 2820 IF KCH2=37 THEN DTTM$=DTTM$+CHR$(3)+"N":DFILE=-1:GOTO 3160:'a-K
  283. 2830 IF KCH2=36 THEN DTTM$=DTTM$+CHR$(3)+"S":DFILE=-1:GOTO 3160:'a-J
  284. 2840 IF KCH2=24 THEN DTTM$=DTTM$+CHR$(3)+"T":DFILE=-1:GOTO 3160:'a-O
  285. 2850 IF KCH2=19 THEN PRINT#1,CHR$(18);:GOTO 3160:'a-R
  286. 2860 IF KCH2=45 THEN PRINT#1,CHR$(24);:GOTO 3160:'a-X
  287. 2870 IF KCH2=48 THEN NOBP= NOT NOBP:GOTO 3160:'a-B
  288. 2880 IF KCH2=44 THEN PRINT#1,CHR$(3);:GOTO 3160:'a-Z
  289. 2890 IF KCH2=18 THEN PRINT#1,CHR$(5);:GOTO 3160:'a-E
  290. 2900 IF KCH2=35 THEN PRINT#1,CHR$(19);:GOTO 3160:'a-H
  291. 2910 IF KCH2=34 THEN PRINT#1,CHR$(20);:GOTO 3160:'a-G
  292. 2920 IF KCH2=17 THEN PRINT#1,CHR$(23);:GOTO 3160:'a-W
  293. 2930 IF KCH2=21 THEN PRINT#1,CHR$(25);:GOTO 3160:'a-Y
  294. 2940 IF KCH2<>30 THEN 2960 ELSE ART=NOT ART:GOSUB 4750:'a-A
  295. 2950 GOSUB 6120:GOTO 3160
  296. 2960 IF KCH2<>31 THEN GOTO 3030 ELSE SELCAL=NOT SELCAL:DSEL=0:PSEL=0:IF SELCAL THEN GOSUB 6220 ELSE MSG$="SELCAL TURNED OFF":GOSUB 6320:GOTO 3160:'a-S
  297. 2970 GOSUB 6260:INPUT "DO YOU WANT SELCAL DATA SENT TO DISK, PRINTER OR BOTH (D/P/B) ";FSEL$:IF FSEL$="" THEN SELCAL=0:GOTO 3020 ELSE P$=CHR$(ASC(LEFT$(FSEL$,1)) OR 32):IF P$<>"p" AND P$<>"b" AND P$<>"d" THEN GOTO 2970
  298. 2980 IF P$="p" THEN PSEL=-1:MSG$="SELCAL SET TO PRINT":GOTO 3010
  299. 2990 GOSUB 6260:INPUT "ENTER SELCAL FILENAME FOR RECEIVING ";FSEL$
  300. 3000 DSEL=-1:IF P$="b" THEN PSEL=-1:MSG$="SELCAL SET TO PRINT AND DISK" ELSE MSG$="SELCAL SET TO DISK"
  301. 3010 GOSUB 6320
  302. 3020 GOSUB 6300:GOSUB 6240:GOTO 3160
  303. 3030 IF KCH2<>38 THEN GOTO 3080 ELSE GOSUB 6220:GOSUB 6260:INPUT "ENTER CALLSIGN OF STATION WORKED ";LOG1$:'a-L
  304. 3040 GOSUB 6260:INPUT "ENTER COMMENTS AND/OR OTHER DATA ";LOG2$
  305. 3050 FERR=0:OPEN "LOG.RTY" FOR APPEND AS #5:IF FERR THEN GOTO 3070
  306. 3060 PRINT#5,DATE$+"  "+TIME$+"  ";:PRINT#5,USING "\        \";LOG1$;:PRINT#5,"  "+LOG2$
  307. 3070 CLOSE #5:GOSUB 6300:GOSUB 6240:GOTO 3160
  308. 3080 IF KCH2<>20 THEN 3090 ELSE MSG$="SWAP TRANSMIT BUFFER":GOSUB 6320:GOSUB 6410:GOTO 3160:'a-T
  309. 3090 IF KCH2<>46 THEN 3100 ELSE MSG$="CLEAR TRANSMIT BUFFER":GOSUB 6320:GOSUB 6570:GOTO 3160:'a-C
  310. 3100 IF KCH2<>49 THEN 3110 ELSE NOTKEYS=NOT NOTKEYS:IF NOTKEYS THEN MSG$="NOT AT KEYS MSG ON":GOSUB 6320:GOTO 3160 ELSE MSG$="NOT AT KEYS MSG OFF":GOSUB 6320:GOTO 3160:'a-N
  311. 3110 IF KCH2<>32 THEN 3120 ELSE GOSUB 6650:GOTO 3160:'a-D
  312. 3120 KCH2 = KCH2 - 119:IF KCH2<1 OR KCH2>10 THEN 3160 ELSE MSG$="SEND FILE"+STR$(KCH2):GOSUB 6320:GOSUB 5700:GOTO 3160:'a-1-0
  313. 3130 IF (BUFFULL OR UNCOMP OR RFILE OR DFILE) THEN KEYBUF$=KEYBUF$+KCH$:GOTO 3160 ELSE IF LEN(KEYBUF$)=0 THEN TCH$=KCH$ ELSE TCH$=LEFT$(KEYBUF$,1):KEYBUF$=RIGHT$(KEYBUF$,LEN(KEYBUF$)-1)+KCH$
  314. 3140 IF LEN(TCH$)=0 THEN 3160
  315. 3150 GOSUB 5060
  316. 3160 NEXT ML
  317. 3170 GOTO 2570
  318. 3180 REM $PAGE
  319. 3190 'GET NEXT RECEIVED CHARACTER & DISPLAY IT
  320. 3200 IF NOT SELCAL THEN IF NOTKEYS THEN 3240 ELSE 3270
  321. 3210 IF TYPE=0 THEN 3220 ELSE IF BSELCAL$=RIGHT$(SELCHK$,LEN(BSELCAL$)) OR GBSEL$=RIGHT$(SELCHK$,LEN(GBSEL$)) THEN GOSUB 3740:GOTO 3270 ELSE GOTO 3260
  322. 3220 IF ASELCAL$=RIGHT$(SELCHK$,LEN(ASELCAL$)) OR GASEL$=RIGHT$(SELCHK$,LEN(GASEL$)) THEN GOSUB 3740:GOTO 3270
  323. 3230 GOTO 3260
  324. 3240 IF NOTKEYS$<>RIGHT$(SELCHK$,LEN(NOTKEYS$)) THEN GOTO 3260 ELSE GOSUB 5870:GOSUB 5750:IF NOT SELCAL THEN FSEL$="WHILE.OUT"
  325. 3250 GOSUB 3750:GOTO 3270
  326. 3260 IF ESEL$=RIGHT$(SELCHK$,LEN(ESEL$)) OR GESEL$=RIGHT$(SELCHK$,LEN(GESEL$)) THEN GOSUB 3810
  327. 3270 BAU=ASC(INPUT$(1,#1)) AND &H7F
  328. 3280 IF TYPE = 0 THEN B$=CHR$(BAU):IF BAU > 31 OR BAU=7 OR BAU=10 OR BAU=13 OR BAU=8 THEN 3360 ELSE RETURN
  329. 3290 'CONVERT BAUDOT INPUT TO ASCII
  330. 3300 IF BAU=0 THEN IF SELCAL OR NOTKEYS THEN SELCHK$=RIGHT$(SELCHK$,9)+CHR$(0):RETURN ELSE RETURN
  331. 3310 IF BAU=27 THEN IF CASE<>1 THEN CASE=1:RETURN ELSE IF SELCAL OR NOTKEYS THEN SELCHK$=RIGHT$(SELCHK$,9)+CHR$(24):RETURN ELSE RETURN
  332. 3320 IF BAU=31 THEN IF CASE<>0 THEN CASE=0:RETURN ELSE IF SELCAL OR NOTKEYS THEN SELCHK$=RIGHT$(SELCHK$,9)+CHR$(25):RETURN ELSE RETURN
  333. 3330 IF UNSHIFT AND BAU=4 THEN CASE=0
  334. 3340 IF CASE=0 THEN B$=CHR$(BDLOW(BAU)) ELSE B$=CHR$(BDUP(BAU))
  335. 3350 'B$ CONTAINS ASCII CHARACTER
  336. 3360 CURIN=ASC(B$)
  337. 3370 IF SELCAL OR NOTKEYS THEN SELCHK$=RIGHT$(SELCHK$,9)+B$
  338. 3380 IF CURIN=13 AND LASTIN=13 THEN RETURN
  339. 3390 IF MARS AND CURIN=7 AND TYPE<>0 THEN B$="@"
  340. 3400 IF NOT COMP THEN 3480
  341. 3410 IF NOT BFILE THEN 3560
  342. 3420 IF CURIN=10 THEN GOTO 3440
  343. 3430 IF CURIN=LASTIN THEN RCNT=RCNT+1:GOTO 3490
  344. 3440 IF LASTIN=10 OR LASTIN=13 THEN 3470 ELSE IF RCNT=1 THEN PRINT#3,CMP$;:GOTO 3470
  345. 3450 IF RCNT=2 THEN PRINT#3,CMP$;CMP$;:GOTO 3470
  346. 3460 IF RCNT=26 THEN PRINT#3,CMP$;CHR$(255);CHR$(25);CMP$; ELSE PRINT#3,CHR$(255);CHR$(RCNT);CMP$;
  347. 3470 CMP$=B$:RCNT=1
  348. 3480 IF NOT BFILE THEN 3560
  349. 3490 IF ART THEN 3530
  350. 3500 IF CURIN=13 THEN PRINT#3,:BFLCNT=BFLCNT+1:GOTO 3540
  351. 3510 IF CURIN=10 AND LASTIN<>13 THEN PRINT#3,:BFLCNT=BFLCNT+1
  352. 3520 GOTO 3540
  353. 3530 IF CURIN=10 OR CURIN=13 THEN PRINT#3,CHR$(CURIN+10); ELSE IF LASTIN=10 OR LASTIN=13 THEN PRINT#3,:BFLCNT=BFLCNT+1
  354. 3540 IF BFLCNT>14 THEN BFLCNT=0:CLOSE #3:OPEN BF$ FOR APPEND AS #3
  355. 3550 IF NOT COMP AND CURIN<>10 AND CURIN<>13 THEN PRINT#3,B$;
  356. 3560 IF ART OR (CURIN <> 10 AND CURIN <> 13) THEN 3610
  357. 3570 IF CURIN=10 AND LASTIN=13 THEN LASTIN=10:RETURN
  358. 3580 IF CURIN=10 THEN 3610
  359. 3590 GOSUB 4520:IF PRNTR THEN LP$=B$:GOSUB 3850
  360. 3600 B$=CHR$(10)
  361. 3610 LASTIN = CURIN
  362. 3620 IF MARS AND CURIN=7 AND TYPE<>0 THEN B$=CHR$(7)
  363. 3630 IF PRNTR THEN LP$=B$:GOSUB 3850
  364. 3640 GOSUB 4520:'PUT CHARACTER ON SCREEN
  365. 3650 RETURN
  366. 3660 'SET TO BAUDOT LETTERS MODE
  367. 3670 CASE=0:RETURN
  368. 3680 REM $PAGE
  369. 3690 'FORCE A CR-LF IN RX MODE
  370. 3700 IF PRNTR THEN LP$=CHR$(13):GOSUB 3850:LP$=CHR$(10):GOSUB 3850
  371. 3710 IF BFILE THEN PRINT#3,:BFLCNT=BFLCNT+1
  372. 3720 NEWLINE=-1:RETURN
  373. 3730 'START SELCAL SAVE FILE
  374. 3740 IF PSEL THEN IF NOT PRNTR THEN PRNTR=-1:FK$(6)="PRT ON":GOSUB 6120:PSCACT=-1
  375. 3750 IF BFILE THEN RETURN ELSE IF NOT DSEL THEN RETURN ELSE GOSUB 6220:COMP=0:IF FSEL$="" THEN 3790
  376. 3760 BF$=FSEL$:FERR=0:OPEN FSEL$ FOR APPEND AS #3
  377. 3770 IF FERR THEN CLOSE #3:GOTO 3790
  378. 3780 BFILE=-1:SCACT=-1:GOSUB 6260
  379. 3790 GOSUB 6300:GOSUB 6240:RETURN
  380. 3800 'STOP SELCAL SAVE FILE
  381. 3810 IF PSEL THEN IF PSCACT THEN PSCACT=0:PRNTR=0:FK$(6)="PRT OF":GOSUB 6120
  382. 3820 IF BFILE AND SCACT THEN GOSUB 6220:PRINT#3,:CLOSE #3:BFILE=0:SCACT=0:GOSUB 6300:GOSUB 6240:RETURN
  383. 3830 RETURN
  384. 3840 'SEND DATA TO PRINTER
  385. 3850 ON ERROR GOTO 3990
  386. 3860 LP=ASC(LP$)
  387. 3870 IF LP<>7 THEN PRINT#4,LP$;
  388. 3880 IF LP>31 THEN LPCNT=LPCNT+1 ELSE IF LP=12 OR LP=13 THEN LPCNT=0 ELSE IF LP=10 THEN PRINT#4,STRING$(LPCNT," ");
  389. 3890 ON ERROR GOTO 3910:RETURN
  390. 3900 'ERROR HANDLER
  391. 3910 IF ERR=57 OR ERR=69 THEN RESUME
  392. 3920 IF ERR=53 OR ERR=55 OR ERR=64 THEN FERR=-1:GOTO 3950
  393. 3930 IF ERR<>61 THEN ON ERROR GOTO 0:CLS:ERROR ERR:END
  394. 3940 BFILE=0:CLOSE #3
  395. 3950 IF ERR=53 THEN MSG$="FILE NOT FOUND" ELSE IF ERR=55 THEN MSG$="FILE ALREADY OPEN" ELSE IF ERR=64 THEN MSG$="BAD FILE NAME" ELSE MSG$="DISK FULL"
  396. 3960 GOSUB 6320:BEEP
  397. 3970 RESUME NEXT
  398. 3980 FERR=-1
  399. 3990 RESUME NEXT
  400. 4000 'TOGGLE THE FUNCTION KEY DEFINITIONS
  401. 4010 KEYS = NOT KEYS
  402. 4020 GOSUB 6120
  403. 4030 IF KEYS THEN 4060
  404. 4040 ON KEY(3) GOSUB 4410:KEY(3) ON:ON KEY(4) GOSUB 6100:KEY(4) ON:ON KEY(5) GOSUB 4330:KEY(5) ON:ON KEY(6) GOSUB 4300:KEY(6) ON
  405. 4050 ON KEY(7) GOSUB 4100:KEY(7) ON:ON KEY(8) GOSUB 4230:KEY(8) ON:ON KEY(9) GOSUB 3700:KEY(9) ON:ON KEY(10) GOSUB 3670:KEY(10) ON:RETURN
  406. 4060 ON KEY(3) GOSUB 5610:KEY(3) ON:ON KEY(4) GOSUB 5740:KEY(4) ON:ON KEY(5) GOSUB 4280:KEY(5) ON:ON KEY(6) GOSUB 5720:KEY(6) ON
  407. 4070 ON KEY(7) GOSUB 6050:KEY(7) ON:ON KEY(8) GOSUB 5590:KEY(8) ON:ON KEY(9) GOSUB 5540:KEY(9) ON:ON KEY(10) GOSUB 5870:KEY(10) ON:RETURN
  408. 4080 REM $PAGE
  409. 4090 'TOGGLE THRU BAUD RATES & SET DIVISOR ON ASYNC ADAPTER
  410. 4100 BAUD = BAUD + 1
  411. 4110 IF BAUD >= MAXBAUD(TYPE) THEN BAUD = 0
  412. 4120 DIVHL=XTAL!/BD.RTE(TYPE,BAUD):DIVLO=DIVHL MOD 256:DIVHI=DIVHL\256:FK$(7)=BD.RT$(TYPE,BAUD)
  413. 4130 IER.SAVE=INP(IER)
  414. 4140 OUT IER,0
  415. 4150 OUT LINE.CTL,INP(LINE.CTL) OR &H80
  416. 4160 OUT DIV.LSB,DIVLO
  417. 4170 OUT DIV.MSB,DIVHI
  418. 4180 OUT LINE.CTL,INP(LINE.CTL) AND &H7F
  419. 4190 OUT IER,IER.SAVE
  420. 4200 GOSUB 6120
  421. 4210 RETURN
  422. 4220 'TOGGLE BETWEEN BAUDOT AND ASCII MODE
  423. 4230 TYPE = TYPE+1
  424. 4240 IF TYPE >= 2 THEN TYPE = 0
  425. 4250 IF TYPE = 0 THEN OUT LINE.CTL,ALCR:FK$(8)="ASCII " ELSE OUT LINE.CTL,4:FK$(8)="BAUDOT"
  426. 4260 BAUD=0:GOTO 4120
  427. 4270 'RESET REQUESTED
  428. 4280 RST = NOT RST:RETURN
  429. 4290 'SEND RECEIVED CHARACTERS TO PRINTER
  430. 4300 PRNTR = NOT PRNTR:IF PRNTR THEN FK$(6)="PRT ON" ELSE FK$(6)="PRT OF"
  431. 4310 GOSUB 6120:RETURN
  432. 4320 'ALL DONE - EXIT
  433. 4330 GOSUB 6220:GOSUB 6260
  434. 4340 BEEP:PRINT "DO YOU REALLY WANT TO QUIT (Y/N)?";
  435. 4350 P$=INKEY$:IF P$="" THEN 4350 ELSE IF P$="Y" OR P$="y" THEN 4380
  436. 4360 GOSUB 6300:GOSUB 6240
  437. 4370 RETURN
  438. 4380 COLOR 7,0:CLS:END
  439. 4390 REM $PAGE
  440. 4400 'SEND RECEIVED CHARACTERS TO FILE
  441. 4410 GOSUB 6220:IF NOT BFILE THEN GOTO 4430 ELSE IF ART OR (LASTIN<>10 AND LASTIN<>13) THEN PRINT#3,
  442. 4420 CLOSE #3:BFILE=0:LASTIN=10:GOTO 4490
  443. 4430 GOSUB 6260:INPUT "ENTER FILENAME FOR RECEIVING ";BF$
  444. 4440 IF BF$="" THEN 4490
  445. 4450 FERR=0:OPEN BF$ FOR APPEND AS #3
  446. 4460 IF FERR THEN GOTO 4490
  447. 4470 BFILE=-1:GOSUB 6260:INPUT "DO YOU WANT COMPRESSION (Y/N) ";P$
  448. 4480 P$=LEFT$(P$,1):IF P$="Y" OR P$="y" THEN COMP=-1 ELSE COMP=0
  449. 4490 GOSUB 6300:GOSUB 6240
  450. 4500 RETURN
  451. 4510 'PUT RECEIVED CHARACTER ON SCREEN AND SCROLL IF NECESSARY
  452. 4520 RCH=ASC(B$):IF RCH=13 THEN CR=1:RETURN
  453. 4530 IF NOBP AND ART AND RCH=7 THEN RETURN
  454. 4540 IF RCH=10 THEN RR=RR+1:GOTO 4590
  455. 4550 IF PACKET AND RCH=8 THEN CR=CR-1:IF CR=0 THEN RR=RR-1:CR=CMAX-1:IF RR=0 THEN RR=1:CR=1
  456. 4560 IF PACKET AND RCH=8 THEN RETURN
  457. 4570 LOCATE RR,CR,0:COLOR RXF,RXB:PRINT B$;
  458. 4580 IF CR=CMAX-1 THEN RR=RR+1:CR=1 ELSE CR=CR+1
  459. 4590 IF RR=RRE+1 THEN RR=RRE:CALL SCROLL (RRB,RRE,CMAX,SCRX)
  460. 4600 RETURN
  461. 4610 'TOGGLE BETWEEN RECEIVE AND TRANSMIT MODE
  462. 4620 MODE=MODE+1
  463. 4630 IF MODE >=2 THEN MODE = 0
  464. 4640 ON MODE+1 GOTO 4660,4700
  465. 4650 'RECEIVE MODE
  466. 4660 IF (INP(LINE.STS) AND &H60) <> &H60 THEN TXEND=-1:RETURN ELSE TXEND=0
  467. 4670 OUT MOD.CTL,(INP(MOD.CTL) AND &HFC) OR RMSK:GOSUB 4750
  468. 4680 NEWLINE=-1:GOSUB 6120:RETURN
  469. 4690 'TRANSMIT MODE
  470. 4700 OUT MOD.CTL,(INP(MOD.CTL)AND &HFC) OR TMSK:GOSUB 4750:SHIFT=0
  471. 4710 PL = VAL(RIGHT$(TIME$,2))
  472. 4720 IF PL = VAL(RIGHT$(TIME$,2)) THEN 4720
  473. 4730 NEWLINE=-1:GOSUB 6120:RETURN
  474. 4740 'SET THE STS INDICATOR FOR RECV/XMIT
  475. 4750 IF MODE=0 THEN FK$(2)="RECV  ":FK$(12)="RECV  " ELSE FK$(2)="XMIT  ":FK$(12)="XMIT  "
  476. 4760 IF ART THEN MID$(FK$(2),6,1)="A":MID$(FK$(12),6,1)="A" ELSE MID$(FK$(2),6,1)="N":MID$(FK$(12),6,1)="N"
  477. 4770 RETURN
  478. 4780 'GET NEXT CHARACTER FROM BUFFER & SEND IT
  479. 4790 IF TPAUSE THEN RETURN
  480. 4800 COA=BUF(BUFS):IF COA=254 THEN GOSUB 6280:TSS!=TCS! ELSE GOSUB 4860
  481. 4810 BUFS=BUFS+1:IF BUFS=BSIZ+1 THEN BUFS=0
  482. 4820 BUFC=BUFN-BUFS:IF BUFC<0 THEN BUFC=BUFC+BSIZ
  483. 4830 IF BUFC>=BSIZ-2 THEN BUFFULL=-1 ELSE BUFFULL=0
  484. 4840 RETURN
  485. 4850 'SEND CHARACTER TO ASYNC ADAPTER
  486. 4860 IF ECHO THEN B$=CHR$(COA):GOSUB 3360
  487. 4870 IF TYPE = 0 THEN CO$=CHR$(COA):GOTO 4940
  488. 4880 'BAUDOT MODE - CHANGE SHIFT IF NECESSARY AND CONVERT ASCII TO BAUDOT
  489. 4890 CT=BDOUT(COA) AND &HC0:CD=BDOUT(COA) AND &H3F:CO$=CHR$(CD)
  490. 4900 IF CT=&HC0 THEN 4940
  491. 4910 IF SHIFT<>1 AND CT=&H40 THEN SHIFT=1:PRINT#1,CHR$(&H1F);:IF CD=&H1F THEN GOTO 4970 ELSE GOTO 4930
  492. 4920 IF SHIFT<>2 AND CT=&H80 THEN SHIFT=2:PRINT#1,CHR$(&H1B);:IF CD=&H1B THEN GOTO 4970
  493. 4930 IF ASC(CO$)=0 THEN 4990
  494. 4940 IF SPLF AND COA=10 THEN 4990 ELSE PRINT#1,CO$;
  495. 4950 IF NSND THEN NLOOP=NLOOP-1:IF NLOOP=0 THEN NSND=0:GOTO 4990 ELSE GOTO 4860
  496. 4960 IF MARS THEN NCHK$ = RIGHT$(NCHK$,3)+CHR$(COA AND &HDF):IF NCHK$="NNNN" THEN NSND=-1:COA=NCHR:NLOOP=12:NCHK$="":GOTO 4860
  497. 4970 IF COA=13 AND NOT PACKET THEN PRINT#1,CO$; ELSE IF (COA=10) AND NOT MARS AND (TYPE<>0) THEN SHIFT=1:PRINT#1,CHR$(&H1F);
  498. 4980 IF NOT EURO AND COA=43 AND TYPE<>0 THEN FOR PL = 1 TO 11:PRINT#1,CO$;:NEXT PL
  499. 4990 GOSUB 6280:LDS=SS
  500. 5000 RETURN
  501. 5010 REM $PAGE
  502. 5020 'GET NEXT COLUMN NUMBER
  503. 5030 IF CWT<>0 AND CWT<>200 THEN CW=CWT
  504. 5040 RETURN
  505. 5050 'PUT CHAR TO SEND ON SCREEN AND INTO BUFFER
  506. 5060 TCH=ASC(TCH$):IF UNCOMP THEN TCNT=TCNT-1:TCH=UTCH:TCH$=UTCH$:IF TCNT=0 THEN UNCOMP=0:GOTO 5290 ELSE GOTO 5290
  507. 5070 IF UCNT THEN UCNT=0:UNCOMP=-1:UTCH=TCH:IF TCH=13 THEN UTCH$=CHR$(23):RETURN ELSE UTCH$=TCH$:RETURN
  508. 5080 IF USTRT THEN USTRT=0:UCNT=-1:TCNT=TCH:RETURN
  509. 5090 IF CRLF THEN CRLF=0:IF TCH=10 THEN LTCH=10:RETURN
  510. 5100 IF (BLLF OR MARS) AND TCH=13 AND CW=1 THEN TCH=10:CRLF=-1
  511. 5110 IF QBL THEN QBL=0:IF TCH=7 THEN LTCH=7:RETURN
  512. 5120 IF TCH<>8 THEN 5260 ELSE IF BUFS=BUFE THEN IF PACKET THEN 5250 ELSE RETURN ELSE BUFC=BUFE:BUFE=BUFE-1:IF BUFE<0 THEN BUFE=BSIZ
  513. 5130 IF BUFL(BUFE)=0 OR BUFL(BUFE)=200 THEN CWS=CW:LOCATE RW,CW,0:COLOR TXF,TXB:PRINT " ";:RW=RW-1:IF RW<RWB THEN RW=RWB:GOTO 5170 ELSE LOCATE RW,CW,0:STCH=SCREEN(RW,CW):COLOR TXBR,TXFR:PRINT CHR$(STCH):GOTO 5220
  514. 5140 LOCATE RW,CW,0:IF BUFL(BUFC)=0 THEN STCH=SCREEN(RW,CW):COLOR TXF,TXB:PRINT CHR$(STCH) ELSE COLOR TXF,TXB:PRINT " ";:IF BUF(BUFE)=13 THEN BUFL(BUFC)=-1:GOTO 5170
  515. 5150 IF BUFL(BUFE)=CMAX-1 THEN RW=RW-1
  516. 5160 IF RW>=RWB THEN 5210 ELSE RW=RWB
  517. 5170 BUFC=BUFE
  518. 5180 CWT=BUFL(BUFC):GOSUB 5030:LOCATE RW,CW,0:COLOR TXF,TXB:IF BUF(BUFC)=13 THEN PRINT CHR$(23); ELSE PRINT CHR$(BUF(BUFC));
  519. 5190 IF BUFC=BUFS THEN 5210 ELSE BUFC=BUFC-1:IF BUFC<0 THEN BUFC=BSIZ
  520. 5200 IF BUF(BUFC)<>10 AND BUF(BUFC)<>13 AND BUFL(BUFC)<>CMAX-1 THEN 5180
  521. 5210 CW=CWS:CWT=BUFL(BUFE):GOSUB 5030:LOCATE RW,CW,0:COLOR TXBR,TXFR:PRINT " ";:BUFL(BUFE)=-1
  522. 5220 BUFC=BUFE-1:IF BUFC<0 THEN BUFC=BSIZ
  523. 5230 LTCH=BUF(BUFC):IF LTCH=13 THEN LTCH=23
  524. 5240 RETURN
  525. 5250 COA=8:GOSUB 4860:IF CW=1 THEN RETURN ELSE LOCATE RW,CW,0:COLOR TXF,TXB:PRINT " ";:CW=CW-1:LOCATE RW,CW,0:COLOR TXBR,TXFR:PRINT " ";:RETURN
  526. 5260 IF TCH=18 THEN DTTM$=DTTM$+TL$:DFILE=-1:RETURN
  527. 5270 IF TCH=19 THEN 5480
  528. 5280 IF TCH=255 THEN USTRT=-1:RETURN
  529. 5290 IF TCH=13 OR TCH=10 THEN IF LTCH=20 OR LTCH=23 THEN RETURN ELSE TCH$=CHR$(TCH+10)
  530. 5300 LOCATE RW,CW,0:STCH=SCREEN(RW,CW):COLOR TXF,TXB:IF TCH<>10 AND TCH<>20 THEN PRINT TCH$ ELSE IF STCH<>32 THEN PRINT CHR$(STCH); ELSE IF NOT NOBP OR NOT ART OR TCH<>7 THEN PRINT TCH$;
  531. 5310 IF TCH=10 THEN BUFL(BUFE)=0 ELSE IF TCH=20 THEN BUFL(BUFE)=200 ELSE BUFL(BUFE)=CW
  532. 5320 IF TCH=13 OR TCH=23 THEN CW=1:GOTO 5350
  533. 5330 IF TCH=10 OR TCH=20 THEN RW=RW+1:GOTO 5350
  534. 5340 IF CW=CMAX-1 THEN RW=RW+1:CW=1 ELSE CW=CW+1
  535. 5350 BUFN=BUFE+1:IF BUFN=BSIZ+1 THEN BUFN=0
  536. 5360 BUFC=BUFN-BUFS:IF BUFC<0 THEN BUFC=BUFC+BSIZ
  537. 5370 IF BUFC>=BSIZ-2 THEN BUFFULL=-1
  538. 5380 IF TCH=20 OR TCH=23 THEN BUF(BUFE)=TCH-10 ELSE BUF(BUFE)=TCH
  539. 5390 BUFE=BUFN:LTCH=TCH
  540. 5400 IF TCH=13 THEN TCH=10:CRLF=-1:BUFL(BUFE)=0:GOTO 5330
  541. 5410 IF QBEL AND TCH=39 THEN TCH=7:TCH$=CHR$(7):QBL=-1:GOTO 5300
  542. 5420 IF RW=24 THEN RW=23:CALL SCROLL (RWB,RWE,CMAX,SCTX)
  543. 5430 LOCATE RW,CW,0:COLOR TXBR,TXFR:STCH=SCREEN(RW,CW):IF STCH=32 THEN PRINT " "; ELSE PRINT CHR$(STCH)
  544. 5440 IF CW=CWARN THEN BEEP
  545. 5450 IF (CW=CEND) AND ATCR THEN TCH=13:GOTO 5290
  546. 5460 RETURN
  547. 5470 'GET TEMPORARY LINE TO STORE
  548. 5480 GOSUB 6220:GOSUB 6260
  549. 5490 BEEP:LINE INPUT "ENTER MESSAGE TO STORE ? ";TL$
  550. 5500 GOSUB 6300:GOSUB 6240
  551. 5510 RETURN
  552. 5520 REM $PAGE
  553. 5530 'ENTER QSO ID FOR USE WITH TTY ID
  554. 5540 GOSUB 6220:GOSUB 6260
  555. 5550 BEEP:LINE INPUT "ENTER THE CALL SIGN ? ";QSO$
  556. 5560 GOSUB 6300:GOSUB 6240
  557. 5570 RETURN
  558. 5580 'SEND RTTY ID
  559. 5590 DTTM$=DTTM$+QSO$+TTYID$:IF ZTM THEN DTTM$=DTTM$+"   ":GOTO 5870 ELSE DTTM$=DTTM$+CHR$(13):DFILE=-1:RETURN
  560. 5600 'GET FILE TO SEND
  561. 5610 GOSUB 6220:IF RFCNT=6 THEN RETURN
  562. 5620 GOSUB 6260:INPUT "ENTER FILENAME FOR TRANSMITTING ";R$(RFCNT)
  563. 5630 IF R$(RFCNT)="STOP" OR R$(RFCNT)="stop" THEN 5790
  564. 5640 IF R$(RFCNT)="" THEN 5670
  565. 5650 RFCNT = RFCNT + 1
  566. 5660 IF NOT RFILE THEN 5790
  567. 5670 GOSUB 6300:GOSUB 6240
  568. 5680 RETURN
  569. 5690 'PUT SPECIFIED FILE IN TX QUE
  570. 5700 IF RFCNT=6 THEN RETURN ELSE R$(RFCNT)=FLNM$(KCH2):GOSUB 6220:GOTO 5640
  571. 5710 'GET RYs FILE TO SEND
  572. 5720 IF RFCNT=6 THEN RETURN ELSE R$(RFCNT)="RYS.RTY":GOSUB 6220:GOTO 5650
  573. 5730 'GET CQ FILE TO SEND
  574. 5740 IF RFCNT=6 THEN RETURN ELSE R$(RFCNT)="CQ.RTY":GOSUB 6220:GOTO 5650
  575. 5750 'GET NOT HOME FILE TO SEND
  576. 5760 BEEP:BEEP
  577. 5770 IF RFCNT=6 THEN RETURN ELSE R$(RFCNT)="AWAY.MSG":GOSUB 6220:GOTO 5650
  578. 5780 'CLOSE THE CURRENT TX FILE AND START THE NEXT ONE
  579. 5790 IF RFCNT=0 THEN CLOSE #2:RFILE=0:GOTO 5670 ELSE RF$=R$(0)
  580. 5800 FOR PL=1 TO RFCNT-1:R$(PL-1)=R$(PL):NEXT PL
  581. 5810 RFCNT=RFCNT-1:CLOSE #2
  582. 5820 FERR=0:OPEN RF$ FOR INPUT AS #2
  583. 5830 IF FERR THEN GOTO 5790
  584. 5840 RFILE=-1:GOTO 5670
  585. 5850 REM $PAGE
  586. 5860 'SEND TIME AND DATE
  587. 5870 PD$ = DATE$:PT$ = TIME$:PDT$ = DTM$
  588. 5880 MO=VAL(LEFT$(PD$,2)):DAY=VAL(MID$(PD$,4,2)):YR=VAL(RIGHT$(PD$,2)):YR4=VAL(RIGHT$(PD$,4))
  589. 5890 HR=VAL(LEFT$(PT$,2)):MIN=VAL(MID$(PT$,4,2)):SEC=VAL(RIGHT$(PT$,2))
  590. 5900 IF NOT ZTM THEN 5920
  591. 5910 HR=HR+UTM:IF HR>23 THEN HR=HR-24:DAY=DAY+1:IF DAY>MON(MO) THEN DAY=1:MO=MO+1:IF MO>12 THEN MO=1:YR=(YR+1) MOD 100:YY4=YY4+1
  592. 5920 PSTR = INSTR(PDT$,"YYYY"):IF PSTR <> 0 THEN MID$(PDT$,PSTR,4) = RIGHT$(STR$(YR4),4)
  593. 5930 PSTR = INSTR(PDT$,"YY"):IF PSTR <> 0 THEN MID$(PDT$,PSTR,2) = RIGHT$(STR$(YR),2):IF MID$(PDT$,PSTR,1)=" " THEN MID$(PDT$,PSTR,1)="0"
  594. 5940 PSTR = INSTR(PDT$,"MONTH"):IF PSTR <> 0 THEN PDT$ = LEFT$(PDT$,PSTR-1)+MO$(MO)+RIGHT$(PDT$,(LEN(PDT$)-PSTR-4))
  595. 5950 PSTR = INSTR(PDT$,"MON"):IF PSTR <> 0 THEN MID$(PDT$,PSTR,3) = LEFT$(MO$(MO),3)
  596. 5960 PSTR = INSTR(PDT$,"MO"):IF PSTR <> 0 THEN MID$(PDT$,PSTR,2) = RIGHT$(STR$(MO),2):IF MID$(PDT$,PSTR,1)=" " THEN MID$(PDT$,PSTR,1)="0"
  597. 5970 PSTR = INSTR(PDT$,"DD"):IF PSTR <> 0 THEN MID$(PDT$,PSTR,2) = RIGHT$(STR$(DAY),2):IF MID$(PDT$,PSTR,1)=" " THEN MID$(PDT$,PSTR,1)="0"
  598. 5980 PSTR = INSTR(PDT$,"HH"):IF PSTR <> 0 THEN MID$(PDT$,PSTR,2) = RIGHT$(STR$(HR),2):IF MID$(PDT$,PSTR,1)=" " THEN MID$(PDT$,PSTR,1)="0"
  599. 5990 PSTR = INSTR(PDT$,"MM"):IF PSTR <> 0 THEN MID$(PDT$,PSTR,2) = RIGHT$(STR$(MIN),2):IF MID$(PDT$,PSTR,1)=" " THEN MID$(PDT$,PSTR,1)="0"
  600. 6000 PSTR = INSTR(PDT$,"SS"):IF PSTR <> 0 THEN MID$(PDT$,PSTR,2) = RIGHT$(STR$(SEC),2):IF MID$(PDT$,PSTR,1)=" " THEN MID$(PDT$,PSTR,1)="0"
  601. 6010 PSTR = INSTR(PDT$,"TMT"):IF PSTR <> 0 THEN PDT$ = LEFT$(PDT$,PSTR-1)+TMTYP$+RIGHT$(PDT$,(LEN(PDT$)-PSTR-2))
  602. 6020 DTTM$=DTTM$+PDT$+CHR$(13)
  603. 6030 DFILE=-1:RETURN
  604. 6040 'STOP SENDING CHARACTERS BUT STAY IN TX MODE
  605. 6050 TPAUSE = NOT TPAUSE
  606. 6060 IF TPAUSE THEN FK$(17)="PSE ON" ELSE FK$(17)="PSE OF"
  607. 6070 GOSUB 6120
  608. 6080 RETURN
  609. 6090 'TOGGLE THE UNSHIFT ON SPACE FUNCTION - RECEIVE ONLY
  610. 6100 UNSHIFT=NOT UNSHIFT:IF UNSHIFT THEN FK$(4)="UOS ON" ELSE FK$(4)="UOS OF"
  611. 6110 'DISPLAY THE CURRENT FUNCTION KEY DEFINITIONS
  612. 6120 IF (SL=24) AND MSG THEN RETURN
  613. 6130 GOSUB 6220:LOCATE SL,1,0:IF KEYS THEN IS=11:IE=20 ELSE IS=1:IE=10
  614. 6140 FOR PL = IS TO IE
  615. 6150 COLOR KEYBR,KEYFR:PRINT USING"#";PL MOD 10;
  616. 6160 COLOR KEYF,KEYB:PRINT FK$(PL);
  617. 6170 IF PL MOD 10 <> 0 THEN IF (PL MOD 5 <> 0) OR (SL<>24) THEN COLOR KEYBR,KEYFR:PRINT " "; ELSE LOCATE 25,1,0
  618. 6180 NEXT PL
  619. 6190 GOSUB 6240:OLDCLR=SCREEN(OLDCUR,OLDPOS,1):OCLRF=OLDCLR MOD 16:OCLRB=((OLDCLR-OCLRF)/16) MOD 128:IF OLDCLR>127 THEN OCLRF=OCLRF+16
  620. 6200 COLOR OCLRF,OCLRB:RETURN
  621. 6210 'GET THE CURRENT CURSOR LOCATION AND SAVE IT
  622. 6220 OLDCUR=CSRLIN:OLDPOS=POS(0):RETURN
  623. 6230 'RELOCATE AT THE SAVED CURSOR LOCATION
  624. 6240 LOCATE OLDCUR,OLDPOS,0:RETURN
  625. 6250 'ROUTINE TO CLEAR CENTER LINE
  626. 6260 COLOR STSBR,STSFR:LOCATE TMLN1,1,0:PRINT STRING$(79," ");:COLOR STSF,STSB:LOCATE TMLN1,1,0:RETURN
  627. 6270 'ROUTINE TO GET THE TIME IN HOURS, MINUTES, SECONDS AND TOTAL SECONDS
  628. 6280 TI$=TIME$:SH=VAL(MID$(TI$,1,2)):SM=VAL(MID$(TI$,4,2)):SS=VAL(MID$(TI$,7,2)):TCS!=CSNG(SH)*3600+CSNG(SM)*60+SS:RETURN
  629. 6290 'ROUTINE TO PRINT THE DATE ON CENTER LINE
  630. 6300 GOSUB 6260:LOCATE TMLN1,15,0:ZDT$=DATE$:PRINT ZDT$;:RETURN
  631. 6310 'ROUTINE TO DISPLAY MESSAGE ON LINE 24
  632. 6320 GOSUB 6220:COLOR ERRBR,ERRFR:LOCATE 24,1,0:IF SL=24 THEN PRINT STRING$(39," "); ELSE PRINT STRING$(79," ");
  633. 6330 COLOR ERRF,ERRB:LOCATE 24,1,0:PRINT MSG$;
  634. 6340 PMSG=VAL(RIGHT$(TIME$,2)):PMSG=PMSG+5:IF PMSG>59 THEN PMSG=PMSG-60
  635. 6350 MSG=-1:RETURN
  636. 6360 'ROUTINE TO CLEAR LINE 24
  637. 6370 IF SL=24 THEN MSG=0:GOTO 6120
  638. 6380 GOSUB 6220:COLOR KEYBR,KEYFR:LOCATE 24,1,0:PRINT STRING$(79," ");:GOSUB 6240:GOSUB 6120
  639. 6390 MSG=0:RETURN
  640. 6400 'ROUTINE TO SWAP THE TRANSMIT BUFFER
  641. 6410 IF TXBUF THEN 6510
  642. 6420 IF RFILE THEN CLOSE #2:RFILE=0:RFCNT=0
  643. 6430 FERR=0:OPEN "TXBUFFER.RTY" FOR OUTPUT AS #2
  644. 6440 IF FERR THEN 6490
  645. 6450 IF BUFS=BUFE THEN 6490
  646. 6460 PRINT#2,CHR$(BUF(BUFS));
  647. 6470 BUFS=BUFS+1:IF BUFS=BSIZ+1 THEN BUFS=0
  648. 6480 GOTO 6450
  649. 6490 CLOSE #2:TXBUF=-1
  650. 6500 GOSUB 6570:GOSUB 6260:GOSUB 6300:RETURN
  651. 6510 GOSUB 6570:RF$="TXBUFFER.RTY"
  652. 6520 FERR=0:OPEN RF$ FOR INPUT AS #2
  653. 6530 IF FERR THEN 6550
  654. 6540 RFILE=-1
  655. 6550 TXBUF=0:RETURN
  656. 6560 'ROUTINE TO CLEAR THE TX BUFFER AND STOP ALL CURRENT INPUT
  657. 6570 IF RFILE THEN CLOSE #2
  658. 6580 RFILE=0:UNCOMP=0:DFILE=0:BUFFULL=0:KEYBUF$="":DTTM$="":RFCNT=0
  659. 6590 BUFS=0:BUFE=0:RW=RWB:CW=1
  660. 6600 FOR PL = 1 TO 25
  661. 6610 CALL SCROLL (RWB,RWE,CMAX,SCTX)
  662. 6620 NEXT PL
  663. 6630 LOCATE RW,CW,0:COLOR TXBR,TXFR:PRINT " ";
  664. 6640 RETURN
  665. 6650 PD$ = DATE$:PT$ = TIME$:PDT$ = PDAT$
  666. 6660 PSTR = INSTR(PDT$,"YYYY"):IF PSTR <> 0 THEN MID$(PDT$,PSTR,4) = MID$(PD$,7,4)
  667. 6670 PSTR = INSTR(PDT$,"YY"):IF PSTR <> 0 THEN MID$(PDT$,PSTR,2) = MID$(PD$,9,2)
  668. 6680 PSTR = INSTR(PDT$,"MO"):IF PSTR <> 0 THEN MID$(PDT$,PSTR,2) = MID$(PD$,1,2)
  669. 6690 PSTR = INSTR(PDT$,"DD"):IF PSTR <> 0 THEN MID$(PDT$,PSTR,2) = MID$(PD$,4,2)
  670. 6700 PSTR = INSTR(PDT$,"HH"):IF PSTR <> 0 THEN MID$(PDT$,PSTR,2) = MID$(PT$,1,2)
  671. 6710 PSTR = INSTR(PDT$,"MM"):IF PSTR <> 0 THEN MID$(PDT$,PSTR,2) = MID$(PT$,4,2)
  672. 6720 PSTR = INSTR(PDT$,"SS"):IF PSTR <> 0 THEN MID$(PDT$,PSTR,2) = MID$(PT$,7,2)
  673. 6730 PRINT#1,PDT$
  674. 6740 RETURN
  675. 9000 'THIS IS THE RTTYSUBS ASSEMBLER CODE FOR SCROLLING HALF SCREENS
  676. 9010 'PAGE,132
  677. 9020 'TITLE RTTY SUBROUTINES FOR BASIC PROGRAMS - BACKGROUND ATTRIBUTE PASSING
  678. 9030 'SUBS    SEGMENT PUBLIC 'CODE'
  679. 9040 '        ASSUME  CS:SUBS,DS:NOTHING
  680. 9050 '
  681. 9060 '        PUBLIC  SCROLL
  682. 9070 '
  683. 9080 'SCROLL  PROC    FAR
  684. 9090 ';**********************************************************************
  685. 9100 ';
  686. 9110 ';  ON ENTRY PARAMETERS PASSED ARE THE POINTERS TO
  687. 9120 ';  STARTING ROW (INTEGER), ENDING ROW (INTEGER)
  688. 9130 ';  NUMBER OF COLUMNS (INTEGER), AND BACKGROUND ATTRIBUTE
  689. 9140 ';
  690. 9150 ';**********************************************************************
  691. 9160 '
  692. 9170 '        PUSH    BP
  693. 9180 '        MOV     BP,SP           ;GET THE PARAMETERS FROM THE STACK AREA
  694. 9190 '        MOV     SI,[BP]+12      ;GET PARM 'A'
  695. 9200 '        MOV     CH,[SI]         ;STARTING ROW FOR SCROLL
  696. 9210 '        MOV     SI,[BP]+10      ;GET PARM 'B'
  697. 9220 '        MOV     DH,[SI]         ;ENDING ROW FOR SCROLL
  698. 9230 '        MOV     SI,[BP]+8       ;GET PARM 'C'
  699. 9240 '        MOV     DL,[SI]         ;NUMBER OF COLUMNS
  700. 9250 '        MOV     SI,[BP]+6       ;GET PARM 'D'
  701. 9260 '        MOV     BH,[SI]         ;ATTRIBUTE OF CHARACTER
  702. 9270 '        DEC     CH              ;CONVERT THE ROWS AND COLUMNS TO
  703. 9280 '        DEC     DH              ;VALUES REQUIRED BY THE
  704. 9290 '        DEC     DL              ;VIDEO-OUT INTERRUPT
  705. 9300 '        MOV     CL,0            ;START AT LEFT HAND SIDE OF SCREEN
  706. 9310 '        MOV     AX,CS           ;POINT TO A NEW STACK AREA
  707. 9320 '        CLI
  708. 9330 '        MOV     SS,AX
  709. 9340 '        MOV     SP,OFFSET STACK_TOP
  710. 9350 '        STI
  711. 9360 '        PUSH    BP              ;SAVE THE ORIGINAL STACK POINTER
  712. 9370 '        MOV     AX,601H         ;SCROLL UP LEAVING ONE LINE BLANK
  713. 9380 '        INT     10H             ;INVOKE BIOS VIDEO ROUTINES
  714. 9390 '        POP     BP              ;RETRIEVE THE ORIGINAL STACK POINTER
  715. 9400 '        CLI
  716. 9410 '        MOV     AX,DS           ;RESTORE THE ORIGINAL SS:SP
  717. 9420 '        MOV     SS,AX
  718. 9430 '        MOV     SP,BP
  719. 9440 '        STI
  720. 9450 '        POP     BP
  721. 9460 '        RET     8               ;RETURN TO BASIC
  722. 9470 'PAGE
  723. 9480 '
  724. 9490 '        DW      50 DUP(?)
  725. 9500 'STACK_TOP       LABEL   NEAR
  726. 9510 '
  727. 9520 'SCROLL  ENDP
  728. 9530 '
  729. 9540 'SUBS    ENDS
  730. 9550 '        END
  731.